home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / matt's utils 8sept / f-pt-in-scroll.lisp < prev    next >
Encoding:
Text File  |  1992-09-08  |  3.5 KB  |  97 lines  |  [TEXT/CCL2]
  1. ;;;
  2. ;;; f-pt-in-scroll.lisp
  3. ;;;
  4.  
  5. #|
  6. ================================================================
  7. Purpose ========================================================
  8. ================================================================
  9. Defines f-pt-in-scroll, a handy addition to sequence-dialog-items and
  10. fred-windows. Thanks to holz@urz.unibas.ch (Dieter Holz) for help with
  11. the fred-window version.
  12.  
  13.  
  14. ================================================================
  15. Status =========================================================
  16. ================================================================
  17. Implemented.
  18.  
  19.  
  20. ================================================================
  21. Change history =================================================
  22. ================================================================
  23. 18-Aug-92 mc    Created.
  24. 07-Sep-92 mc    Defined a f-pt-in-scroll method for fred-windows.
  25.  
  26. |#
  27.  
  28.  
  29. (in-package "CCL")
  30.  
  31. (export '(F-PT-IN-SCROLL)
  32.         "CCL")
  33.  
  34. ;;;
  35.  
  36. (defgeneric f-pt-in-scroll (sequence-dialog-item pt-local-to-container)
  37.   (:documentation "Returns non-nil when pt-local-to-container is in either
  38. sequence-dialog-item's vertical or horizontal scrollbar."))
  39.  
  40.  
  41. ;;; Define a method for sequence-dialog-items.
  42.  
  43. (defmethod f-pt-in-scroll ((sequence-dialog-item sequence-dialog-item)
  44.                           (pt-local-to-container integer))
  45.   (declare (optimize speed))
  46.   ;;
  47.   (let* ((f-h-scroll-bar (table-hscrollp sequence-dialog-item))
  48.          (f-v-scroll-bar (table-vscrollp sequence-dialog-item))
  49.          (pt-bot-right (add-points (view-position sequence-dialog-item)
  50.                                    (view-size sequence-dialog-item)))
  51.          (int-pt-h (point-h pt-local-to-container))
  52.          (int-pt-v (point-v pt-local-to-container))
  53.          (f-pt-in-v-scroll-bar (and f-v-scroll-bar
  54.                                     (>= int-pt-h (- (point-h pt-bot-right) 16))))
  55.          (f-pt-in-h-scroll-bar (and f-h-scroll-bar
  56.                                     (>= int-pt-v (- (point-v pt-bot-right) 16)))))
  57.     (or f-pt-in-v-scroll-bar f-pt-in-h-scroll-bar)))
  58.  
  59.  
  60. ;;; Define a method for fred-windows.
  61.  
  62. #|
  63. (defmethod f-pt-in-scroll ((fred-window fred-window)
  64.                           (pt-local-to-container integer))
  65.   (declare (optimize speed))
  66.   ;;
  67.   (let* ((h-ctl-record-vscroll (slot-value fred-window 'ccl::vscroll))
  68.          (h-ctl-record-hscroll (slot-value fred-window 'ccl::hscroll)))
  69.     (with-dereferenced-handles ((p-ctl-rec-vscroll h-ctl-record-vscroll)
  70.                                 (p-ctl-rec-hscroll h-ctl-record-hscroll))
  71.       (let* ((p-ctl-rect-vscroll
  72.               (rref p-ctl-rec-vscroll :controlRecord.contrlRect :storage :pointer))
  73.              (p-ctl-rect-hscroll
  74.               (rref p-ctl-rec-hscroll :controlRecord.contrlRect :storage :pointer)))
  75.         (let* ((f-pt-in-v-scroll-bar (#_PtInRect pt-local-to-container
  76.                                       p-ctl-rect-vscroll))
  77.                (f-pt-in-h-scroll-bar (#_PtInRect pt-local-to-container
  78.                                       p-ctl-rect-hscroll)))
  79.           (or f-pt-in-v-scroll-bar f-pt-in-h-scroll-bar))))))
  80. |#
  81.  
  82. ;;; Following cleaner version based on code provided by holz@urz.unibas.ch
  83. ;;;  (Dieter Holz) :
  84.  
  85. (defmethod f-pt-in-scroll ((fred-window fred-window)
  86.                           (pt-local-to-container integer))
  87.   (declare (optimize speed))
  88.   ;;
  89.   (rlet ((p-control-record :ControlRecord))
  90.     (#_FindControl pt-local-to-container (wptr fred-window) p-control-record)
  91.     (%setf-macptr p-control-record (%get-ptr p-control-record))
  92.     (not (%null-ptr-p p-control-record))))
  93.  
  94.  
  95. ;;; Done.
  96.  
  97. (provide "F-PT-IN-SCROLL")